home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d4 / lander.arc / LANDER.BAS (.txt) next >
Encoding:
GW-BASIC  |  1986-06-15  |  17.4 KB  |  400 lines
  1. 10  CLEAR,,2000:A$="VERSION   1.0"  ' Program : LANDER.BAS
  2. 20  DEF SEG=&H40: EQUIP=PEEK(&H10)
  3. 30  IF (EQUIP AND &H30) = &H30 THEN I1 = 0 ELSE I1 = 1
  4. 40  DEF SEG: WIDE = 40: JOY = 0: PRT = 0
  5. 50  COLR = 1: ADJUST = 1
  6. 60  PROGNAME$ = "     LUNAR LANDER"
  7. 70  SCREEN 0,1: KEY OFF: GOSUB 3190
  8. 80  GOSUB 1390    'Get lander pictures from disk.
  9. 90  GOSUB 160     'Setup initial conditions
  10. 100  GOSUB 480     'Display Moving ship
  11. 110  GOSUB 900     'Test for Crash or Landing
  12. 120  GOSUB 770     'Revise control parameters
  13. 130  GOSUB 620     'See if any keys pressed.
  14. 140  GOTO 100       'CYCLE.
  15. 150  REM $S2
  16. 160  REM##########  SETUP  INITIAL  CONDITIONS  ##########
  17. 170  REM X,Y=POSITION, F=FUEL, T=THRUST, SX,SY=SPEED, TILT=MODULE TILT,
  18. 180  REM GRAV=GRAVITY, S=SCORE
  19. 190  REM $S1
  20. 200  Z=FRE(A$):F=4000*(1-S/1000):F0=F:T=10:SX=30:SY=0:GRAV=10+S/100:X=0:Y=0:ANG=1:TILT=1:C=1:IF F<1500 THEN F=1500
  21. 210  XOLD=X:YOLD=Y:TILTOLD=TILT:TOLD=T
  22. 220  SCREEN 1:CLS:COLOR 0,0:LAND=1:KEY OFF:A=RND(100*-VAL(RIGHT$(TIME$,2))):FOR I=1 TO 5:A$=INKEY$:NEXT:IF GRAV>15 THEN GRAV=15
  23. 230  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  24. 240  IF GAUGE=0 GOTO 270
  25. 250  LOCATE 1,28:PRINT " SCORE=" S:LOCATE 2,29:PRINT " FALL=" SY
  26. 260  LOCATE 3,28:PRINT "THRUST=" T:LOCATE 4,30:PRINT "FUEL=" F:GOTO 340
  27. 270  LOCATE 4,30:PRINT"L   L   E":LOCATE 5,30:PRINT"        R"
  28. 280  LOCATE 1,30:PRINT"F   F   P":LOCATE 2,30:PRINT"U   A   O":LOCATE 3,30:PRINT"E   L   W"
  29. 290  LINE(241,0)-(257,35),1,BF:LINE(241,36)-(257,40),2,BF 'Fuel Gauge
  30. 300  LINE(273,5)-(289,10),1,BF:LINE(273,11)-(289,40),2,BF:LINE(273,0)-(289,4),2,BF 'Fall Gauge
  31. 310  LINE(304,15)-(319,25),1,BF:LINE(304,26)-(319,40),2,BF:LINE(304,0)-(319,14),2,BF 'Power Gauge
  32. 320  G1=0:LINE (241,G1)-(257,G1),0:G2=10:LINE(273,G2)-(289,G2),3:G3=20:LINE(304,G3)-(319,G3),3
  33. 330  REM $S2
  34. 340  REM########### lander picture  ###########################
  35. 350  REM $S1
  36. 360  LX(1)=0:LY(1)=40:LINE(LX(1),LY(1))-(LX(1)+1,LY(1)),1
  37. 370  BOT=30+260*RND  ' X-VALUE OF FIELD.
  38. 380  FOR I=2 TO LP
  39. 390  LY(I)=LY(1)+(194-LY(1))*ABS(COS(3.14*(1+S/600)*(LX(I)-BOT-15)/400))
  40. 400  LY(I)=LY(I)+SQR(LY(I))*(0.5-RND)  'add noise to land contour.
  41. 410  IF((LX(I)>BOT)AND(LX(I)<(BOT+30)))THEN LY(I)=198  ' landing field
  42. 420  IF(LY(I)>198)THEN LY(I)=198 'prevent overflow of screen
  43. 430  LINE -(LX(I),LY(I)),3:NEXT
  44. 440  PAINT(0,199),1,3:LINE (BOT+5,193)-(BOT+25,199),2,BF
  45. 450  IF S>ADLAND THEN FOR I=0 TO 6:PSET(BOT+I*5,180),2:NEXT 'Window for Advan.Lndr.
  46. 460  PUT(X,Y),R1:ADVAN=0:BEEP:RETURN 'ADVAN=1 FOR ADVANCED LANDER GAME.
  47. 470  REM $pa
  48. 480  '############  Display moving Ship   and Gauges ####################
  49. 490  REM $S1
  50. 500  GOSUB 2330:IF MUSIC=1 GOTO 520 ELSE IF F=0 GOTO 520 '  Display picture.
  51. 510  PLAY "mb":SOUND TUNE(C,0),TUNE(C,1):SOUND TUNE(C+1,0),TUNE(C+1,1):C=C+2:IF C>149 THEN C=1  'Play "Blue DAnube Waltz"
  52. 520  IF GAUGE=0 GOTO 550 ELSE LOCATE 2,35:PRINT INT(-SY):LOCATE 3,35:PRINT INT(T)
  53. 530  LOCATE 4,35:PRINT INT(F): IF F=0 THEN SOUND 99,0:BEEP
  54. 540  RETURN
  55. 550  GG1=INT(40-40*F/F0):IF GG1=G1 THEN GOTO 560 ELSE LINE(241,GG1)-(257,GG1),0
  56. 560  G1=GG1:GG2=INT(5+SY/(2.8+(S>ADLAND))):IF GG2<0 THEN GG2=0 ELSE IF GG2>40 THEN GG2=40
  57. 570  IF GG2=G2 THEN GOTO 580 ELSE LINE(273,GG2)-(289,GG2),3:IF G2<11 AND G2>4 THEN LINE(273,G2)-(289,G2),1 ELSE LINE(273,G2)-(289,G2),2
  58. 580  G2=GG2:GG3=INT(40-40*T/19):IF GG3=G3 THEN GOTO 590 ELSE LINE(304,GG3)-(319,GG3),3:IF G3<26 AND G3>14 THEN LINE(304,G3)-(319,G3),1 ELSE LINE(304,G3)-(319,G3),2
  59. 590  G3=GG3:IF F=0 THEN SOUND 99,0:BEEP
  60. 600  RETURN
  61. 610  REM $S1
  62. 620  '########  Check KEYBOARD for commands  ############################
  63. 630  REM $S1
  64. 640  K$=RIGHT$(INKEY$,1):IF (K$="")THEN RETURN:IF (F=0)THEN RETURN
  65. 650  A$=INKEY$:  ' IF A$><"" GOTO 500
  66. 660  J=INSTR("HPMK"+CHR$(27),K$):ON J GOTO 680,700,720,740,1060
  67. 670  RETURN
  68. 680  T=T+1:IF T>19 THEN T=19
  69. 690  RETURN
  70. 700  T=T-1:IF(T<0)THEN T=0
  71. 710  RETURN
  72. 720  TILT=TILT+1:IF (TILT>NANG)THEN TILT=1
  73. 730  RETURN
  74. 740  TILT=TILT-1:IF (TILT<1)THEN TILT=NANG
  75. 750  RETURN
  76. 760  REM $S1
  77. 770  '################ Revise CONTROL parameters  ####################
  78. 780  REM $S1
  79. 790  SY=SY+GRAV-T*COS(3.14*ANG(TILT)/180):SX=0.9*SX+T*SIN(3.14*ANG(TILT)/180) ' SX has air drag.
  80. 800  IF (SY<-10)THEN SY=-10
  81. 810  X=X+SX*0.05:Y=Y+SY*0.05:IF (Y<0) THEN Y=0
  82. 820  IF (Y+MY>199)THEN Y=199-MY
  83. 830  IF (X<0)THEN X=0
  84. 840  IF(X+MX>319)THEN X=319-MX
  85. 850  IF(F=0) THEN T=0:RETURN
  86. 860  F=F-T:IF(F<0)THEN F=0:T=0:LOCATE 6,9:PRINT"OUT OF FUEL":GOSUB 880
  87. 870  RETURN
  88. 880  FOR J=1 TO 5:FOR K=1000 TO 2000 STEP 20:SOUND K,0.182:NEXT:NEXT:RETURN'alarm
  89. 890  REM $s1
  90. 900  '######## TEST FOR CRASH OR LANDING.  ##############################
  91. 910  REM $s1
  92. 920  IF Y>198-MY AND BOT<(5+X) AND (BOT+30)>(X+MX-5) GOTO 1120
  93. 930  IF Y>198-MY GOTO 1020
  94. 940  FOR I=(1+X/4) TO ((X+MX)/4-1):IF (Y+MY-6)>LY(I) GOTO 1020:NEXT'Each LX=4 unit
  95. 950  IF S<ADLAND OR ADVAN=1 THEN RETURN
  96. 960  IF Y>185-MY AND BOT<(5+X) AND (BOT+30)>(X+MX-5) AND SY<10 GOTO 2820 ELSE RETURN
  97. 970  REM $pa
  98. 980  '################# END OF PROGRAM  ########################
  99. 990  REM $S1
  100. 1000  FOR I=0 TO 8 STEP 2:COLOR I,0:FOR J=1 TO 200:NEXT J:NEXT I:COLOR 0,2
  101. 1010  LOCATE 5,1:PRINT STRING$(40,22);:PRINT STRING$(240,0);:PRINT STRING$(240,0);:PRINT STRING$(40,22);:RETURN
  102. 1020  GOSUB 1210:GOSUB 1220:GOSUB 1230:GOSUB 1000:CLS:LOCATE 6,1 :FOR I=1 TO 5:PRINT "     CRASH !!!  CRASH !!!  CRASH !!!":NEXT
  103. 1030  LOCATE 12,8:PRINT"YOU NEED MORE PRACTISE !!"
  104. 1040  A$=INKEY$:IF A$<>"" GOTO 1040 ELSE LOCATE 15,1:PRINT"PRESS ANY OTHER KEY TO CONTINUE":PRINT"PRESS `Q'= QUIT;`S'=SILENCE;`M'=MUSIC":PRINT"         GAUGES `A'=ANALOG, `D'=DIGITAL"
  105. 1050  A$=INKEY$:IF A$="" GOTO 1050
  106. 1060  IF 0<>INSTR("Qq",A$) THEN SCREEN 0,1: GOSUB 3510
  107. 1070  IF 0<>INSTR("Ss",A$) THEN MUSIC=1: GOTO 1050
  108. 1080  IF 0<>INSTR("Mm",A$) THEN MUSIC=0: GOTO 1050
  109. 1090  IF 0<>INSTR("Aa",A$) THEN GAUGE=0: GOTO 1050
  110. 1100  IF 0<>INSTR("Dd",A$) THEN GAUGE=1: GOTO 1050
  111. 1110  IF S<ADLAND OR ADVAN=1 THEN GOTO 90 ELSE GOTO 1320
  112. 1120   IF SY>15-6*ADVAN  GOTO 1190
  113. 1130  SOUND 99,0:IF (TILT<>1) GOTO 1200 'Turn off "Blue Danube"
  114. 1140  GOSUB 1210:C=1:D=30:GOSUB 1290:GOSUB 1000:C=31:D=50:GOSUB 1290:CLS:LOCATE 9,10:PRINT "PERFECT  LANDING !!":S=S+INT(F/30):FOR I=0 TO 3500:NEXT:C=51:D=82:GOSUB 1290
  115. 1150  IF S>SCOREMAX THEN SCOREMAX=S:GOSUB 1170
  116. 1160  LOCATE 11,1:PRINT"YOUR EXTRA FUEL MAKES YOUR SCORE = " S CHR$(13) CHR$(13) " (MAX. SCORE TO DATE IS " SCOREMAX " BY " INIT$ ")":GOTO 1040
  117. 1170  LOCATE 11,1:PRINT"YOUR SCORE IS NOW " S " !!!!!!" CHR$(13) "THIS IS THE HIGHEST SCORE UP TO NOW !!" CHR$(13) "TYPE IN 3 INITIALS FOR POSTERITY :"
  118. 1180  DEF SEG:POKE 106,0:INPUT "INITIALS: ",A$:INIT$=LEFT$(A$,3):OPEN "lander.scr" FOR OUTPUT AS #3:PRINT#3,SCOREMAX,INIT$:CLOSE:GOSUB 1000:RETURN
  119. 1190  GOSUB 1210:GOSUB 1220:GOSUB 1000:CLS:LOCATE 8,1:PRINT"ALMOST A GOOD LANDING BUT MUCH TOO FAST":LOCATE 10,2:PRINT"YOUR FALL RATE MUST BE LESS THAN "15-5*ADVAN:GOTO 1030
  120. 1200  GOSUB 1210:GOSUB 1220:GOSUB 1000:LOCATE 8,1:PRINT"GOOD LANDING, BUT PLEASE LAND ON 2 FEET!":GOTO 1030
  121. 1210  T=0:GOSUB 480:RETURN ' Show ship with no rocket blast.
  122. 1220  SOUND 99,0:FOR J=1 TO 3:FOR K=1000 TO 2000 STEP 20:SOUND K,0.182:NEXT:NEXT:S=INT(S*0.7):RETURN ' Crash sound
  123. 1230   EX=10+X-(X<11)*10:EX=EX+(EX>309)*10:EY=Y+10-(Y<11)*10:EY=EY+(EY>189)*5 '***explosion***
  124. 1240   FOR I=0 TO NE:LINE(EX-EXPL(I,0),EY-EXPL(I,1))-(EX+EXPL(I,0),EY+EXPL(I,1)/2),2
  125. 1250   LINE(EX+EXPL(I,0),EY-EXPL(I,1))-(EX-EXPL(I,0),EY+EXPL(I,1)/2),2:NEXT:RETURN
  126. 1260  REM $S2
  127. 1270  '############### Play MUSIC ##########################################
  128. 1280  REM $S1
  129. 1290  SOUND 99,0:PLAY"MB":FOR J=C TO D:SOUND TUNE1(J,0),TUNE1(J,1)/2:IF TUNE1(J,0)><0 AND TUNE1(J,1)><1 THEN SOUND 32767,1
  130. 1300  NEXT
  131. 1310  RETURN'Above is "Stars and Stripes"
  132. 1320  SCREEN 0,1: IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  133. 1330  COLOR 0,2,2:CLS:LOCATE 5,9:PRINT"YOUR SCORE IS NOW : " S:COLOR 7,2
  134. 1340  LOCATE 7,5:PRINT"YOU WILL NOW BE IN ADVANCED LANDER ! !":LOCATE 12,1:COLOR 0:   PRINT"IF YOU MANOUVER THE LANDER THROUGH THE  RED DOTS ABOVE THE LANDING FIELD WITH A"
  135. 1350  PRINT"FALL RATE LESS THAN 10, YOU WILL END    THE LANDING IN ADVANCED-LANDER. THE LANDWILL BE ENLARGED TO ALLOW YOU TO MAKE A PRECISION LANDING. YOUR FINAL FALL RATE MUST BE LESS THAN ";
  136. 1360  COLOR 0:PRINT"-- 10 --",:COLOR 0:PRINT"FOR THE LANDING TO BE OK.":LOCATE 24,7,0:COLOR 7:PRINT"PRESS ANY KEY TO CONTINUE.";
  137. 1370  A$=INKEY$:IF A$="" GOTO 1370 ELSE GOTO 90
  138. 1380  REM $pa
  139. 1390  '######################  START  PROGRAM  #########################
  140. 1400  REM $S1
  141. 1410  DEF SEG=0:IF (109=PEEK (&H410))GOTO 1430' go to color screen if on Bw
  142. 1420  POKE &H410,(PEEK(&H410) AND &HCF) OR &H20:SCREEN 0
  143. 1430  KEY OFF:SCREEN 0,1:COLOR 0,2,2:WIDTH 40:CLS:LOCATE 4,12,0:PRINT "IBM    IBM    IBM"
  144. 1440  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  145. 1450  COLOR 7,2:LOCATE 6,12,0:PRINT "Personal Computer"
  146. 1460  COLOR 4,0:LOCATE 9,9,0:PRINT CHR$(201)+STRING$(21,205)+CHR$(187)
  147. 1470  LOCATE 10,9,0:PRINT CHR$(186)+STRING$(21,32)+CHR$(186)
  148. 1480  LOCATE 11,9,0:PRINT CHR$(186)+"    ROCKET LANDER    "+CHR$(186)
  149. 1490  LOCATE 12,9,0:PRINT CHR$(186)+STRING$(21,32)+CHR$(186)
  150. 1500  LOCATE 13,9,0:PRINT CHR$(186)+"    " A$ "    "+CHR$(186)
  151. 1510  LOCATE 14,9,0:PRINT CHR$(186)+STRING$(21,32)+CHR$(186)
  152. 1520  LOCATE 15,9,0:PRINT CHR$(200)+STRING$(21,205)+CHR$(188)
  153. 1530  COLOR 7,1:LOCATE 19,6,0:PRINT"PRESS ANY KEY FOR INSTRUCTIONS"
  154. 1540  A$=INKEY$:IF A$="" GOTO 1540
  155. 1550  REM $S2
  156. 1560  '################  INSTRUCTIONS   ################################
  157. 1570  REM $S1
  158. 1580  COLOR 0,2:CLS:PRINT CHR$(13) "The object is to successfully land the  space-craft on the landing pad. This is done by changing the rocket thrust and  direction using the four position keys."
  159. 1590  LOCATE 7,1:COLOR 20:PRINT "    " CHR$(24);:COLOR 7:PRINT"  Increases the rocket thrust." CHR$(13)
  160. 1600  COLOR 20:PRINT "    " CHR$(25);:COLOR 7:PRINT "  Decreases rocket thrust." CHR$(13)
  161. 1610  COLOR 20:PRINT "    " CHR$(26);:COLOR 7:PRINT "  Tilts the rocket to the right." CHR$(13)
  162. 1620  COLOR 20:PRINT "    " CHR$(27);:COLOR 7:PRINT "  Tilts the rocket to the left." CHR$(13)
  163. 1630  COLOR 16:LOCATE 18,2:PRINT"LOADING DISKETTE IMAGES               ":
  164. 1640  REM $S2
  165. 1650  '###########  Get Ship pictures from disk #######################
  166. 1660  '####### M = Module; R = Small rocket; RR = Large rocket ########
  167. 1670  REM $S1
  168. 1680  DEFINT M,R,P,X,T,L,B: S=66: DIM PDATA(20)
  169. 1690  DIM M1(S),M2(S),M3(S),M4(S),M5(S),M6(S),M7(S),M8(S),M9(S),M10(S),M11(S),M12(S),M13(S)
  170. 1700  DIM R1(S),R2(S),R3(S),R4(S),R5(S),R6(S),R7(S),R8(S),R9(S),R10(S),R11(S),R12(S),R13(S)
  171. 1710  DIM RR1(S),RR2(S),RR3(S),RR4(S),RR5(S),RR6(S),RR7(S),RR8(S),RR9(S),RR10(S),RR11(S),RR12(S),RR13(S)
  172. 1720  DEF SEG=0:A=VARPTR(PDATA(0))
  173. 1730  DEF SEG:BLOAD"LANDER.BIN",A
  174. 1740  NANG=PDATA(0):SIZE=PDATA(1):MX=PDATA(2):MY=PDATA(3)
  175. 1750  DIM ANG(NANG):FOR I=1 TO NANG:ANG(I)=PDATA(3+I):NEXT
  176. 1760  OPEN "lander.scr" FOR INPUT AS #2 'Get maximum score to date.
  177. 1770  INPUT#2,SCOREMAX,INIT$:CLOSE
  178. 1780  DEFINT L: LP=80:DIM LX(LP),LY(LP),LAX(LP),LAY(LP) '  LAND pictures.
  179. 1790  LX(1)=0:LY(1)=40:LAY(1)=0:BOT=224:FOR I=2 TO LP :LAX(I)=I*319/LP:LX(I)=LAX(I)'Adv-Lander Field
  180. 1800  LAY(I)=LAY(1)+(194-LAY(1))*ABS(COS(3.14*(LAX(I)-BOT-15)/400))
  181. 1810  LAY(I)=LAY(I)+SQR(LAY(I))*(0.5-RND)  'add noise to land contour.
  182. 1820  IF((LAX(I)>BOT)AND(LAX(I)<(BOT+30)))THEN LAY(I)=198  ' landing field
  183. 1830  IF(LAY(I)>198)THEN LAY(I)=198
  184. 1840  NEXT
  185. 1850  NE=10:DIM EXPL(NE,1):FOR I=0 TO NE:READ EXPL(I,0),EXPL(I,1):NEXT'Explosion
  186. 1860  DATA 0,10,1,7,2,8,3,3,4,2,5,8,6,7,7,1,8,6,9,2,10,0
  187. 1870  DIM IBMX(75),IBMY(75) ' Get IBM Logo.
  188. 1880  FOR I=0 TO 75:READ IBMX(I):NEXT
  189. 1890  FOR I=0 TO 75 STEP 2:READ IBMY(I):IBMY(I+1)=IBMY(I):NEXT
  190. 1900  DATA 0,4,7,13.5,18,21.5,27,30,0,4,7,14.5,18,22.5,26,30,1,3,8,10,12.5,15,19,23,25.5,29,1,3,8,14.5,19,24,25,29,1,3,8,14.5,19,21,21.6,26.4,27,29,1,3,8,10,12.5,15,19,21,22.3,25.7,27,29,0,4,7,14.5,18,21,23,25,27,30,0,4,7,13.5,18,21,23.5,24.5,27,30
  191. 1910  DATA 0,0,0,0,1,1,1,1,2,2,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,7,7,7,7,7
  192. 1920  DIM MM(88),TUNE(150,1):FOR I=0 TO 6:MM(I)=32767:NEXT ' Get success tune.
  193. 1930  FOR I=7 TO 88: MM(I)=INT(36.8*(2^(1/12))^(I-6)):NEXT
  194. 1940  FOR I=1 TO 150:READ A,TUNE(I,1):TUNE(I,0)=MM(A):NEXT
  195. 1950  REM $s2
  196. 1960  'Blue Danube Waltz by J.S.Strauss
  197. 1970  REM $s1
  198. 1980  DATA 42,4,46,4,49,4,49,4,0,4,61,2,0,2,61,2,0,6,58,2,0,2,58,2,0,6,42,4,42,4
  199. 1990  DATA 46,4,49,4
  200. 2000  DATA 49,4,0,4,61,2,0,2,61,2,0,6,59,2,0,2,59,2,0,6,41,4,41,4,44,4,51,4,51,4
  201. 2010  DATA 0,4,63,2,0,2,63,2,0,6,59,2,0,2
  202. 2020  DATA 59,2,0,6,41,4,41,4,44,4,51,4,51,4,0,4,63,2,0,2,63,2,0,6,58,2,0,2,58,2
  203. 2030  DATA 0,6,42,4
  204. 2040  DATA 42,4,46,4,49,4,54,4,0,4,66,2,0,2,66,2,0,6,61,2,0,2,61,2,0,6,42,4
  205. 2050  DATA 42,4,46,4,49,4,54,4,0,4,66,2,0,2
  206. 2060  DATA 66,2,0,6,63,2,0,2,63,2,0,6,44,4,44,4,47,4,51,2,0,2,51,14,0,2,48,4
  207. 2070  DATA 49,4,58,16
  208. 2080  DATA 54,4,46,4,46,8,44,4,51,8,49,4,42,4,0,2,42,2,42,4,0,8,49,2,0,2,47,2
  209. 2090  DATA 0,6,49,2,0,2
  210. 2100  DATA 47,2,0,6,49,4,58,16,56,4,49,2,0,2,46,2,0,6,49,2,0,2,46,2,0,6,49,4
  211. 2110  DATA 56,16,54,4,49,2,0,2,47,2,0,6,49,2,0,2,47,2,0,6,49,4,58,16
  212. 2120  DATA 56,4,49,4,54,4,56,4,58,4,61,8,59,4,58,2,58,2,58,4,56,2,0,2,54,4,0,8
  213. 2130  DIM TUNE1(82,1):FOR I=1 TO 82:READ A,TUNE1(I,1):TUNE1(I,0)=MM(A):NEXT
  214. 2140  REM $s2
  215. 2150  '"STARS AND STRIPES FOREVER - SOUSA "
  216. 2160  REM $s1
  217. 2170  DATA 54,6,54,6,52,3,51,3,51,6,50,3,51,3,51,16,0,2,50,3
  218. 2180  DATA 51,3,51,6,50,3,51,3
  219. 2190  DATA 54,6,51,3,54,3,52,12,49,6,0,3,49,3,49,6,48,3,49,3
  220. 2200  DATA 49,6,48,3,49,3
  221. 2210  DATA 52,16,0,2,51,3,49,3,51,3,54,9,56,9,56,3,49,16,0,2,54,6
  222. 2220  DATA 54,6,52,3,51,3,51,6,50,3,51,3,51,16,0,2,50,3,51,3,51,6,50,3 ,51,3
  223. 2230  DATA 52,3,51,3,49,5,46,1,49,12,47,6,0,3,47,3,47,6,46,3,47,3,50,6,49,3,47,3
  224. 2240  DATA 59,15,0,3,47,3,49,3,51,3,54,1,0,2,47,3,49,3,51,3,54,1,0,2,42,3,44,5
  225. 2250  DATA 51,1,49,12,47,1
  226. 2260  ADVAN=0:GAUGE=1
  227. 2270  COLOR 0: LOCATE 18,2
  228. 2280  PRINT"Gravity = Vertical thrust of about 10.":COLOR 7,1:LOCATE 24,3:PRINT "  Press any key to start the game.";
  229. 2290  COLOR 0,2:LOCATE 20,2:ADLAND=100:PRINT"Advanced-Lander starts above 100 points.";
  230. 2300  A$=INKEY$:IF A$="" GOTO 2300
  231. 2310  S=0:RETURN
  232. 2320  REM $S2
  233. 2330  '##############  Get New SHIP picture  #########################
  234. 2340  REM $S1
  235. 2350  ON INT(1.8+TOLD/10) GOSUB 2390,2530,2670 'Erase old picture.
  236. 2360  XOLD=X:YOLD=Y:TILTOLD=TILT:TOLD=T
  237. 2370  ON INT(1.8+T/10) GOSUB 2390,2530,2670 'Draw new picture.
  238. 2380  TOLD=T:NEWPIC=0:RETURN
  239. 2390  ON TILTOLD GOTO 2400,2410,2420,2430,2440,2450,2460,2470,2480,2490,2500,2510,2520
  240. 2400  PUT(XOLD,YOLD),M1:RETURN
  241. 2410  PUT(XOLD,YOLD),M2:RETURN
  242. 2420  PUT(XOLD,YOLD),M3:RETURN
  243. 2430  PUT(XOLD,YOLD),M4:RETURN
  244. 2440  PUT(XOLD,YOLD),M5:RETURN
  245. 2450  PUT(XOLD,YOLD),M6:RETURN
  246. 2460  PUT(XOLD,YOLD),M7:RETURN
  247. 2470  PUT(XOLD,YOLD),M8:RETURN
  248. 2480  PUT(XOLD,YOLD),M9:RETURN
  249. 2490  PUT(XOLD,YOLD),M10:RETURN
  250. 2500  PUT(XOLD,YOLD),M11:RETURN
  251. 2510  PUT(XOLD,YOLD),M12:RETURN
  252. 2520  PUT(XOLD,YOLD),M13:RETURN
  253. 2530  ON TILTOLD GOTO 2540,2550,2560,2570,2580,2590,2600,2610,2620,2630,2640,2650,2660
  254. 2540  PUT(XOLD,YOLD),R1:RETURN
  255. 2550  PUT(XOLD,YOLD),R2:RETURN
  256. 2560  PUT(XOLD,YOLD),R3:RETURN
  257. 2570  PUT(XOLD,YOLD),R4:RETURN
  258. 2580  PUT(XOLD,YOLD),R5:RETURN
  259. 2590  PUT(XOLD,YOLD),R6:RETURN
  260. 2600  PUT(XOLD,YOLD),R7:RETURN
  261. 2610  PUT(XOLD,YOLD),R8:RETURN
  262. 2620  PUT(XOLD,YOLD),R9:RETURN
  263. 2630  PUT(XOLD,YOLD),R10:RETURN
  264. 2640  PUT(XOLD,YOLD),R11:RETURN
  265. 2650  PUT(XOLD,YOLD),R12:RETURN
  266. 2660  PUT(XOLD,YOLD),R13:RETURN
  267. 2670  ON TILTOLD GOTO 2680,2690,2700,2710,2720,2730,2740,2750,2760,2770,2780,2790,2800
  268. 2680  PUT(XOLD,YOLD),RR1:RETURN
  269. 2690  PUT(XOLD,YOLD),RR2:RETURN
  270. 2700  PUT(XOLD,YOLD),RR3:RETURN
  271. 2710  PUT(XOLD,YOLD),RR4:RETURN
  272. 2720  PUT(XOLD,YOLD),RR5:RETURN
  273. 2730  PUT(XOLD,YOLD),RR6:RETURN
  274. 2740  PUT(XOLD,YOLD),RR7:RETURN
  275. 2750  PUT(XOLD,YOLD),RR8:RETURN
  276. 2760  PUT(XOLD,YOLD),RR9:RETURN
  277. 2770  PUT(XOLD,YOLD),RR10:RETURN
  278. 2780  PUT(XOLD,YOLD),RR11:RETURN
  279. 2790  PUT(XOLD,YOLD),RR12:RETURN
  280. 2800  PUT(XOLD,YOLD),RR13:RETURN
  281. 2810  REM $s2
  282. 2820  '################ Advanced-Lander Landing Field ##########################
  283. 2830  REM $S1
  284. 2840  SCREEN 1:COLOR 0,0:CLS:LY(1)=0
  285. 2850  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  286. 2860  BEEP:LOCATE 1,1:PRINT"ADVANCED LANDER":PRINT"LANDING FALL":PRINT"LESS THAN -10-"
  287. 2870  LINE(LAX(1),LAY(1))-(LAX(1)+1,LAY(1)),1
  288. 2880  BOT=224:FOR I=2 TO LP :LY(I)=LAY(I)
  289. 2890  LINE -(LAX(I),LAY(I)),3:NEXT
  290. 2900  PAINT(0,199),1,3:LINE (BOT+5,193)-(BOT+25,199),2,BF
  291. 2910  LINE(120,160)-(145,199),2,BF
  292. 2920  FOR I=0 TO 2:LINE(125,165+10*I)-(140,169+10*I),3,BF:NEXT
  293. 2930  LINE (20,130)-(120,199),3,BF 'bldg
  294. 2940  LINE (35,110)-(105,130),0,BF
  295. 2950  FOR I=0 TO 5:FOR J=0 TO 2:LINE(30+14*I,140+J*14)-(40+14*I,150+J*14),0,BF:NEXT:NEXT
  296. 2960  LINE(65,185)-(75,199),0,BF
  297. 2970  LINE(146,175)-(205,199),3,BF
  298. 2980  FOR I=0 TO 4:LINE(150+10*I,178)-(158+10*I,191),0,BF:NEXT
  299. 2990  X=40:Y=113 ' Draw IBM LOGo on Bldg
  300. 3000  FOR I=0 TO 75 STEP 2:LINE (X+2*IBMX(I),Y+2*IBMY(I))-(X+2*IBMX(I+1),Y+2*IBMY(I+1)):NEXT I
  301. 3010  X=90:Y=30:XOLD=X:YOLD=Y:F=F+1000:F0=F:T=11:TOLD=T:TILT=0:TILTOLD=TILT:SY=13:ADVAN=1
  302. 3020  IF GAUGE=0 GOTO 3050
  303. 3030  LOCATE 1,28:PRINT " SCORE=" S:LOCATE 2,29:PRINT " FALL=" SY
  304. 3040  LOCATE 3,28:PRINT "THRUST=" T:LOCATE 4,30:PRINT "FUEL=" F:GOTO 3110
  305. 3050  LOCATE 1,30:PRINT"F   F   P":LOCATE 2,30:PRINT"U   A   O":LOCATE 3,30:PRINT"E   L   W"
  306. 3060  LOCATE 4,30:PRINT"L   L   E":LOCATE 5,30:PRINT"        R"
  307. 3070  LINE(241,0)-(257,35),1,BF:LINE(241,36)-(257,40),2,BF 'Fuel Gauge
  308. 3080  LINE(273,5)-(289,10),1,BF:LINE(273,11)-(289,40),2,BF:LINE(273,0)-(289,4),2,BF 'Fall Gauge
  309. 3090  LINE(304,15)-(319,25),1,BF:LINE(304,26)-(319,40),2,BF:LINE(304,0)-(319,14),2,BF 'Power Gauge
  310. 3100  G1=0:LINE (241,G1)-(257,G1),0:G2=10:LINE(273,G2)-(289,G2),3:G3=20:LINE(304,G3)-(319,G3),3
  311. 3110  PUT(X,Y),R1:BEEP:GOTO 100
  312. 3120  REM $pa
  313. 3130  REM Subroutine to Provide a requirements list to
  314. 3140  REM execute this program
  315. 3150  REM
  316. 3160  REM Switch I1 = 1 if on the COLOR monitor
  317. 3170  REM Switch I1 = 0 if on the MONO  monitor
  318. 3180  REM $s2
  319. 3190  WIDTH 40: IF I1 = 0 THEN COLOR 7,0 ELSE COLOR 0,2,2
  320. 3200  IF I1 = 1 THEN SCREEN 0,1  'text mode and color enabled
  321. 3210  CLS
  322. 3220  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  323. 3230  LOCATE 2,5: PRINT "WELCOME TO THE PROGRAM"
  324. 3240  IF I1 = 0 THEN COLOR 30,0 ELSE COLOR 16,2,2
  325. 3250  LOCATE 3,5: PRINT PROGNAME$
  326. 3260  IF I1 = 0 THEN COLOR 7,0 ELSE COLOR 0,2,2
  327. 3270  LOCATE 5,5: PRINT "THIS PROGRAM REQUIRES:"
  328. 3280  PRINT: PRINT
  329. 3290  IF WIDE = 80 THEN PRINT "    80 CHARACTER RESOLUTION"
  330. 3300  IF WIDE = 40 THEN PRINT "    40 CHARACTER RESOLUTION"
  331. 3310  IF COLR = 1 OR BOTH = 1 THEN PRINT  "    COLOR/GRAPHICS SCREEN  "
  332. 3320  IF BOTH = 1 THEN PRINT  "         OR THE            "
  333. 3330  IF COLR = 0 OR BOTH = 1 THEN PRINT  "    MONOCHROME DISPLAY -IBM"
  334. 3340  IF PRT = 1 THEN PRINT    "    A PRINTER              "
  335. 3350  IF JOY = 1    THEN PRINT "    JOYSTICKS              "
  336. 3360  IF BOTH = 1 THEN GOTO 3440
  337. 3370  IF (COLR = 1 AND I1 = 1) OR (COLR = 0 AND I1 = 0) THEN GOTO 3440
  338. 3380  IF I1 = 0 THEN COLOR 30,0 ELSE COLOR 16,2,2
  339. 3390  SWIT = 1  'signal need to switch monitors
  340. 3400  PRINT: PRINT: PRINT "    YOU MUST SWITCH SCREENS"
  341. 3410  PRINT "    ENTER s TO SWITCH      "
  342. 3420  PRINT "    ANY OTHER WILL END RUN "
  343. 3430  IF I1 = 0 THEN COLOR 7,0 ELSE COLOR 0,2,2
  344. 3440  LOCATE 20,5: PRINT "PRESS ANY KEY TO GO   ": BEEP
  345. 3450  REP$ = INKEY$: IF REP$ = "" THEN GOTO 3450
  346. 3460  IF SWIT=1 AND (REP$="s" OR REP$="S") THEN GOSUB 3710
  347. 3470  RETURN
  348. 3480  REM $s2
  349. 3490  REM Subroutine to provide exit options from this program
  350. 3500  REM $s1
  351. 3510  WIDTH 40: IF I1 = 0 THEN COLOR 7,0 ELSE COLOR 0,2,2
  352. 3520  IF I1 = 1 THEN SCREEN 0,1  'text mode and color enabled
  353. 3530  CLS     'allow use on either monitor
  354. 3540  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  355. 3550  LOCATE 3,5: PRINT "PLEASE CHOOSE FROM FOLLOWING"
  356. 3560  LOCATE 5,5: PRINT "1 = RUN PROGRAM AGAIN       "
  357. 3570  LOCATE 7,5: PRINT "2 = EXIT BACK TO THE MENU   "
  358. 3580  LOCATE 9,5: PRINT "3 = RETURN TO BASIC PROGRAM "
  359. 3590  LOCATE 11,5: PRINT "4 = RETURN TO DOS           "
  360. 3600  LOCATE 20,5: PRINT "ENTER YOUR SELECTION NOW    ": BEEP
  361. 3610  REP$ = INKEY$: IF REP$ = "" THEN GOTO 3610
  362. 3620  IF REP$ = "1" THEN GOTO 10  'RUN (PROGNAME$)
  363. 3630  IF REP$ = "2" THEN CHAIN "MENU"
  364. 3640  IF REP$ = "3" THEN WIDTH 80: CLS: END
  365. 3650  IF REP$ = "4" THEN CLS: SYSTEM
  366. 3660  LOCATE 20,5: PRINT "INVALID SELECTION - TRY AGAIN"
  367. 3670  FOR I = 1 TO 800: NEXT I: CLS: GOTO 3550
  368. 3680  REM $s2
  369. 3690  REM Now switch between the monitors as required
  370. 3700  REM $s1
  371. 3710  IF I1=0 THEN GOTO 3750: ELSE GOTO 3890
  372. 3720  REM $s1
  373. 3730  REM Switch to the COLOR monitor
  374. 3740  REM $s1
  375. 3750  CLS: LOCATE ,,0  'clear screen/turn off mono cursor
  376. 3760  CLS
  377. 3770  DEF SEG=0        'switch to BIOS communications area
  378. 3780  REM set equipment determination flags for color 40 characters
  379. 3790  POKE &H410,(PEEK(&H410) AND &HCF) OR &H10
  380. 3800  DEF SEG          'switch back to BASIC program segment
  381. 3810  SCREEN 0,1: COLOR 0,2,2
  382. 3820  WIDTH 40         'init color adapter to 40 characters, clear screen
  383. 3830  LOCATE ,,1,6,7   'set cursor size for color mode
  384. 3840  IF ADJUST = 1 THEN OUT 980,2: OUT 981,43
  385. 3850  I1 = 1: GOTO 3990
  386. 3860  REM $s2
  387. 3870  REM Switch to the Black and White monitor
  388. 3880  REM $s1
  389. 3890  CLS: LOCATE ,,0  'remove cursor from color screen
  390. 3900  DEF SEG=0        'switch to BIOS communications area
  391. 3910  REM set equipment determination flags for monochrome display 80 chars
  392. 3920  POKE &H410,PEEK(&H410) OR &H30
  393. 3930  DEF SEG          'revert to basic program segment
  394. 3940  SCREEN 1         'be sure next line is a change 02/23/82
  395. 3950  SCREEN 0         'put into text mode for sure
  396. 3960  COLOR 7,0: I1 = 0
  397. 3970  WIDTH 40         'init 40 character mode and clear display
  398. 3980  LOCATE ,,1,12,13 'turn on monochrome cursor position
  399. 3990  RETURN
  400.